Program Kompiler;
Uses LexAnal,Crt,Dos;
{процедура используется и при построении таблицы символов
                        и в синтаксическом анализаторе}
Procedure NewLex(Var ProcLex:char;Var ProcLexId:string);
Type  TNumber = set of '0'..'9';
Const Number:TNumber = ['0'..'9'];
Var   i:string;
Begin
  ProcLex:=BukFromFile;
  i:='';
  If BukFromFile in Number Then Begin end
  Else
  begin
    Read(ScanFile,BukFromFile);
    While BukFromFile in Number do
    begin
      i:=i+BukFromFile;
      Read(ScanFile,BukFromFile);
    end;
    ProcLexId:=i;
  end;
  Repeat
    If (ProcLex='R') and (ProcLexId='22') Then
    begin NewLex(ProcLex,ProcLexId);inc(StrError); end;
  Until not((ProcLex='R') and (ProcLexId='22'));
End;

Procedure PostrTabSymb;
Var NextLexID,ProcPer1,ProcPer2,StrInWrite:string;
    NextLex:char;
    oshibka,sch,FerstMas,LastMas,NumLiterInWrRd:integer;
    SpisPer,Error1,Error2,OK,FindBegin,ReadNextLex:boolean;
    NumFerst,TekNum,NumNum:byte;
    EndTablSymb:PTablSymb;{ускоряет процесс при записи пер в таблицу}

    Function PoiskInTabClas(Tab:byte;pos:integer):string;
    Var  PointProc:PTabData;
         j:integer;
    Begin
      Case Tab of
      1:PointProc:=TabID;
      2:PointProc:=TabNum;
      3:PointProc:=TabLiter;
      end;
      For j:=1 to pos-1 do PointProc:=PointProc^.Next;
      PoiskInTabClas:=PointProc^.El;
    End;
    Procedure NewElTablSymb;
    Var ProcUk:PTablSymb;
    Begin
      If TablSymb<>nil Then
      {не пустая таблица}
      begin
         New(ProcUk);
         EndTablSymb^.Next:=ProcUk;
         EndTablSymb:=ProcUk;
         EndTablSymb^.Next:=nil;
      end
    End;
    Procedure FindFerstEl(interval:integer);
    Var ProcUk:PTablSymb;
        Schet:integer;
    Begin
        ProcUk:=TablSymb;
        For Schet:=1 to interval do ProcUk:=ProcUk^.Next;
        EndTablSymb:=ProcUk;
    End;
Begin{Main}
  New(TablSymb);
  TablSymb:=nil;
  New(EndTablSymb);
  EndTablSymb^.Next:=nil;
  Assign(ScanFile,'Exit.txt');
  Reset(ScanFile);
  StrError:=1;{номер строки с ошибкой}
  Read(ScanFile,BukFromFile);
  FindBegin:=False;
  While (not(eof(ScanFile))) and not(FindBegin) do
  begin
    If (NextLex='S') and (NextLexId='6') Then FindBegin:=True
    Else NewLex(NextLex,NextLexId);
  end;
  TekNum:=0;
  OK:=False;
  NewLex(NextLex,NextLexId);
  ReadNextLex:=False;
  Repeat
    If NextLex = 'I' Then
    begin{2}
      NumFerst:=TekNum+1;
      Error1:=False;
      {переменные одного типа указанные через ','
       при этом NumFerst - номер первой однотипной пер
       в таблице символов}
      Repeat
        Val(NextLexId,NumNum,oshibka);
        inc(TekNum);
        NewElTablSymb;
        EndTablSymb^.Name:=PoiskInTabClas(1,NumNum);
        If TablSymb=nil Then TablSymb:=EndTablSymb;
        NewLex(NextLex,NextLexId);
        {после пременной может стоять только ',' или ':'}
        If (NextLex='S') or (NextLex='C') Then Error1:=True;
        If (NextLex='R') and ((NextLexID<>'1') and (NextLexID<>'4'))
        Then begin Error1:=True;GError:=True;ProcError(10); end;
        {иначе ошибка ERROR1}
        If (NextLex='R') and (NextLexID='1') Then
        begin
        NewLex(NextLex,NextLexId);
        end;
      Until ((NextLex='R') and (NextLexID='4')) or Error1;
      {--}
    end{2}
    Else
    begin{3}
      If (NextLex='S') and
         ((NextLexID='1') or (NextLexID='11')
         or (NextLexID='16')) Then OK:=True;
    end;{3}
    If (not(Error1)) and (not(OK)) Then
    begin{4}
      NewLex(NextLex,NextLexId);
      If (NextLex='S') and (NextLexID='8') Then
      Begin{5}
        NewLex(NextLex,NextLexId);
        If (NextLex='R') and
           (NextLexID='12') Then
        begin{6}
          NewLex(NextLex,NextLexId);
          Val(NextLexId,NumNum,oshibka);
          ProcPer1:=PoiskInTabClas(2,NumNum);
          Val(ProcPer1,FerstMas,oshibka);
          NewLex(NextLex,NextLexId);
          If (NextLex='R') and
             (NextLexID='2') Then
          begin{7}
            NewLex(NextLex,NextLexId);
            If (NextLex='R') and
               (NextLexID='2') Then
            begin{8}
              NewLex(NextLex,NextLexId);
              Val(NextLexId,NumNum,oshibka);
              ProcPer1:=PoiskInTabClas(2,NumNum);
              Val(ProcPer1,LastMas,oshibka);
              NewLex(NextLex,NextLexId);
              If (NextLex='R') and
                 (NextLexID='13') Then
              begin{9}
                NewLex(NextLex,NextLexId);
                If (NextLex='S') and
                   (NextLexID='15') Then
                begin{10}
                  NewLex(NextLex,NextLexId);
                  If (NextLex='S')
                  Then
                  begin{11}
                    If NumFerst<>TekNum Then FindFerstEl(NumFerst-1);
                    For Sch:=NumFerst to TekNum do
                    begin
                      Val(NextLexId,NumNum,oshibka);
                      Case NumNum of
                      7{целое},10{слово}:EndTablSymb^.Razmer:=2*(LastMas-FerstMas+1);
                      9{байт},13{символ},14{булеан}:EndTablSymb^.Razmer:=1*(LastMas-FerstMas+1);
                      12{строка}:EndTablSymb^.Razmer:=256*(LastMas-FerstMas+1);
                      end;
                      Str(FerstMas,ProcPer1);
                      Str(LastMas,ProcPer2);
                      EndTablSymb^.TypePer:='ARRAY'+
                      '['+ProcPer1+'..'+ProcPer2+']'+TabSpecID[NumNum];
                      EndTablSymb^.Zn:='';
                      If (NumFerst<>TekNum) and (Sch<>TekNum) Then
                      EndTablSymb:=EndTablSymb^.Next;
                    end;
                  end{11}
                  Else begin Write('Не указан тип'); Error2:=True end;
                end{10}
                Else begin Write('Нет ТИПА'); Error2:=True end;
              end{9}
              Else begin Write('Нет ]'); Error2:=True end;
            end{8}
            Else begin Write('Нет 2-ой .'); Error2:=True end;
          end{7}
          Else begin Write('Нет 1-ой .'); Error2:=True end;
        end{6}
        Else begin Write('Нет ['); Error2:=True end;
      End{5}
      Else
      Begin
        Val(NextLexId,NumNum,oshibka);
        If NumFerst<>TekNum Then FindFerstEl(NumFerst-1);
        For Sch:=NumFerst to TekNum do
        begin
          Case NumNum of
          7{целое},10{слово}:EndTablSymb^.Razmer:=2;
          9{байт},13{символ},14{булеан}:EndTablSymb^.Razmer:=1;
          12{строка}:EndTablSymb^.Razmer:=256;
          end;
          EndTablSymb^.TypePer:=TabSpecID[NumNum];
          EndTablSymb^.Zn:='';
          If (NumFerst<>TekNum) and (Sch<>TekNum) Then
          EndTablSymb:=EndTablSymb^.Next;
        end;
      End;
    end;{4}
    If not(Error1) and not(OK) Then
    begin
    NewLex(NextLex,NextLexId);
    If (NextLex='R') and (NextLexId='3') Then
       begin Error2:=False; NewLex(NextLex,NextLexId); end
    Else
       begin Error2:=True; GError:=True;ProcError(30);  end;
    end;
  Until Error2 or OK or Error1 or GError;
  NumLiterInWrRd:=0;
  Close(ScanFile);
End;
Procedure WriteTablSymb;
Var i:integer;
    Probel,RazmStr:String;
    ProcUk:PTablSymb;
    Procedure WriteProbel(Dlina:byte);
    Var j:integer;
    Begin
      Probel:='';
      For j:=1 to 20-Dlina do Probel:=Probel+' ';
      Write(Probel);
    End;
Begin
  ClrScr;
  Writeln('ПЕРЕМЕННАЯ          ТИП               РАЗМЕР(бит)        ЗНАЧЕНИЕ');
  Writeln('─────────────────────────────────────────────────────────────────');
  ProcUk:=TablSymb;
  While ProcUk<>nil do
  begin
    Write(ProcUk^.Name);
    WriteProbel(Length(ProcUk^.Name));
    Write(ProcUk^.TypePer);
    WriteProbel(Length(ProcUk^.TypePer));
    Write(ProcUk^.Razmer);
    Str(ProcUk^.Razmer,RazmStr);
    WriteProbel(Length(RazmStr));
    Writeln('...');
    ProcUk:=ProcUk^.Next;
  end;
End;
{-------------------------------------}
Procedure ToAsm;
Var ProcUk:PTablSymb;
    UkTabLit:PTabData;
    TypeMas,NumID,PerStr,LexId,MemLex,ElMas,ForProbel:String;
    Lex:Char;
    Error,ReadLex,OpaInteger,OpaByte,OpaChar,DoProv:Boolean;
    ZnacInIf,ErrorPer,LastIf,NumRecurs,NumLit:integer;

Procedure ProcE;Forward;
Procedure CodeSegment;Forward;
Procedure GetPix;Forward;

Function Probel(P:string):String;
Var Per:string;
    i:byte;
Begin
  Per:=' ';
  For i:= 1 to 20-Length(P) do Per:=Per+' ';
  Probel:=Per;
End;

Function PoiskInTabNumOrLiter(pos:string;Tab:byte):string;
Var PointProc:PTabData;
    j,posint,Error:integer;
Begin
  Case Tab of
  1:PointProc:=TabNum;
  2:PointProc:=TabLiter
  end;
  Val(Pos,PosInt,Error);
  For j:=1 to PosInt-1 do PointProc:=PointProc^.Next;
  PoiskInTabNumOrLiter:=PointProc^.El;
End;

Function PoiskInTabSymb(PosOrZn:string;KakIskat:byte;WhatFind:byte):string;
Var PointProc:PTablSymb;
    j,posint,Error:integer;
Begin
  Case KakIskat of
  1:begin
      Val(PosOrZn,PosInt,Error);
      PointProc:=TablSymb;
      For j:=1 to PosInt-1 do PointProc:=PointProc^.Next;
    end;
  2:begin
      PointProc:=TablSymb;
      While PointProc^.Zn<>PosOrZn do PointProc:=PointProc^.Next;
    end
  end;
  Case WhatFind of
  1:PoiskInTabSymb:=PointProc^.Name;
  2:PoiskInTabSymb:=PointProc^.TypePer;
  end;
  If PointProc=nil Then begin GError:=True;ProcError(32); end;
End;

Procedure ProcF;
Var PerMas,MasType,ElemMasType,LeftGran,CopyMas,PerTypeInProcF:string[35];
    i:byte;
Begin
  If (Lex = 'C') Then
  begin
{    If DoProv Then OpaByte:=True;}
    Write(AsmFile,'                  mov  AX,',PoiskInTabNumOrLiter(LexId,1),#13#10);
    NewLex(Lex,LexId);
  end
  Else
  If (Lex = 'I') and not(Copy(PoiskInTabSymb(LexId,1,2),1,5)='ARRAY')
  Then
  begin
    PerTypeInProcF:=PoiskInTabSymb(LexId,1,2);
    If DoProv Then
    begin
      If PerTypeInProcF='INTEGER' Then OpaInteger:=True;
      If PerTypeInProcF='BYTE' Then OpaByte:=True;
      If PerTypeInProcF='CHAR' Then OpaChar:=True;
    end;
    If PerTypeInProcF='INTEGER' Then
    Write(AsmFile,'                  mov  AX,',PoiskInTabSymb(LexId,1,1),#13#10)
    Else Write(AsmFile,'                  xor  AX,AX'#13#10,
         '                  mov  AL,',PoiskInTabSymb(LexId,1,1),#13#10);
    NewLex(Lex,LexId);
  end
  Else
  If (Lex='I') and (Copy(PoiskInTabSymb(LexId,1,2),1,5)='ARRAY')
  Then
  begin
    PerMas:=PoiskInTabSymb(LexId,1,1);
    MasType:=(PoiskInTabSymb(LexId,1,2));
    ElemMasType:=Copy(MasType,Pos(']',MasType)+1,Length(MasType));
    If DoProv Then
    begin
      If (ElemMasType='INTEGER') Then OpaInteger:=True;
      If (ElemMasType='BYTE') Then OpaByte:=True;
      If (ElemMasType='CHAR') Then OpaChar:=True;
      DoProv:=False;
    end;
    CopyMas:=Copy(MasType,7,Length(MasType));;
    LeftGran:='';
    i:=1;
    While CopyMas[i]<>'.' do
    begin
      LeftGran:=LeftGran+CopyMas[i];
      inc(i);
    end;
    NewLex(Lex,LexId);
    If (Lex='R') and (LexId='12') Then NewLex(Lex,LexId);
    inc(NumRecurs);
    ProcE;
    dec(NumRecurs);
    If NumRecurs=0 Then DoProv:=True;
    Write(AsmFile,'                  sub  AX,',LeftGran,#13#10,
    '                  inc  AX'#13#10);
    If (ElemMasType='INTEGER') Then
    Write(AsmFile,'                  mov  BX,2'#13#10,
    '                  mul  BX'#13#10,
    '                  sub  AX,2'#13#10)
    Else
    Write(AsmFile,'                  dec  AX'#13#10);
    Write(AsmFile,'                  lea  DI,',PerMas,#13#10,
    '                  add  DI,AX'#13#10);
    If (ElemMasType='INTEGER') Then
    Write(AsmFile,'                  mov  BX,[DI]'#13#10,
    '                  mov  AX,BX'#13#10)
    Else Write(AsmFile,'                  mov  BL,[DI]'#13#10,
    '                  mov  AL,BL'#13#10);
    NewLex(Lex,LexId);
  end
  Else
  If (Lex='L') Then
  begin
    OpaChar:=True;
    Write(AsmFile,'                  mov  AX,''',PoiskInTabNumOrLiter(LexId,2),''''#13#10);
    NewLex(Lex,LexId);
  end
  Else
  If (Lex='S') and (LexId='31') Then GetPix
  Else
  If (Lex='R') and (LexId='10') Then
  begin
    NewLex(Lex,LexId);
    ProcE;
    If (Lex='R') and (LexId='11') Then
    begin
      NewLex(Lex,LexId);
    end
    Else If not(GError) Then begin GError:=True;ProcError(24); end;
  end
  Else If not(GError) Then begin GError:=True;ProcError(22); end;
End;
Procedure ProcT;
Begin
  ProcF;
  While (Lex='R') and ((LexId='8') or (LexId='9')) do
  begin
    If (Lex='R') and (LexId='8') Then
    begin
      NewLex(Lex,LexId);
      Write(AsmFile,'                 push  AX'#13#10);
      ProcF;
      Write(AsmFile,'                  pop  BX'#13#10,
      '                  mul  BX'#13#10);
    end
    Else
    If (Lex='R') and (LexId='9') Then
    begin
      NewLex(Lex,LexId);
      Write(AsmFile,'                 push  AX'#13#10);
      ProcF;
      inc(CoolJmpGlobal);
      Write(AsmFile,'                  pop  BX'#13#10,
      '                  mov  DX,BX'#13#10,
      '                  mov  BX,AX'#13#10,
      '                  mov  AX,DX'#13#10,
      '                  mov  DX,0'#13#10,
      '                  cmp  BX,0'#13#10,
      '                  jne  CoolJmp',CoolJmpGlobal,#13#10,
      '                  jmp  EndPrg'#13#10,
      'CoolJmp',CoolJmpGlobal,':'#13#10,
      '                  div  BX'#13#10);
    end;
  end;
End;
Procedure ProcE;
Begin
  ProcT;
  While (Lex='R') and ((LexId='6') or (LexId='7')) do
  begin
    If (Lex='R') and (LexId='6') Then
    begin
      NewLex(Lex,LexId);
      Write(AsmFile,'                 push  AX'#13#10);
      ProcT;
      Write(AsmFile,'                  pop  BX'#13#10,
      '                  add  AX,BX'#13#10);
    end
    Else
    If (Lex='R') and (LexId='7') Then
    begin
      NewLex(Lex,LexId);
      Write(AsmFile,'                 push  AX'#13#10);
      ProcT;
      Write(AsmFile,'                  pop  BX'#13#10,
      '                  sub  BX,AX'#13#10,
      '                  mov  AX,BX'#13#10);
    end;
  end;
End;
Procedure ProcZ;
Begin
  ProcE;
  If not((Lex='R') and (LexId='3'))  Then begin GError:=true;ProcError(16);end;
End;
{процедура присваивания :=}
Procedure Prisvaivanie;
Var ProcType,MasTypeInPrisv,PredelMas,LRStr,MemMasStr:string[25];
    Prov,ErrorPerevod,Left,Rigth,NumElMas:integer;
    i:byte;
    ChisloOk,PerUkInMas,PerStrMasStr:boolean;

    Procedure Zapis(InStek:boolean;TypePer:string);
    Begin
      If (TypePer='INTEGER') Then
      begin
        If not(OpaChar) and not(GError) Then
        begin
          If InStek Then
          Write(AsmFile,'                  pop  BX'#13#10,
          '                  mov  ',MemLex,'+BX,AX'#13#10#13#10)
          Else Write(AsmFile,'                  mov  ',MemLex,',AX'#13#10#13#10)
        end
        Else If not(GError) Then begin GError:=True;ProcError(25); end;
      end;

      If (TypePer='BYTE') Then
      begin
        If not(OpaChar) and not(OpaInteger) and not(GError) Then
        begin
          If InStek Then
          Write(AsmFile,'                  pop  BX'#13#10,
          '                  mov  ',MemLex,'+BX,AL'#13#10#13#10)
          Else Write(AsmFile,'                  mov  ',MemLex,',AL'#13#10#13#10)
        end
        Else If not(GError) Then begin GError:=True;ProcError(25); end;
      end;

      If (TypePer='CHAR') Then
      begin
        If not(OpaByte) and not(OpaInteger) and not(GError) Then
        begin
          If InStek Then
          Write(AsmFile,'                  pop  BX'#13#10,
          '                  mov  ',MemLex,'+BX,AL'#13#10#13#10)
          Else Write(AsmFile,'                  mov  ',MemLex,',AL'#13#10#13#10)
        end
        Else If not(GError) Then begin GError:=True;ProcError(25); end;
      end;

      If (TypePer='STRING') Then
      begin
        If not(GError) Then
        begin
          inc(LiteralToPer);
          If Lex='L' Then
          Write(AsmFile,'                  lea  SI,@',LexId,#13#10)
          Else
          If PerStrMasStr Then
          Write(AsmFile,'                  pop  BX'#13#10,
          '                  lea  SI,',MemMasStr,'+BX'#13#10#13#10)
          Else
          Write(AsmFile,'                  lea  SI,',PoiskInTabSymb(LexId,1,1),#13#10);
          If InStek Then
          Write(AsmFile,'                  pop  BX'#13#10,
          '                  lea  DI,',MemLex,'+BX'#13#10#13#10)
          Else
          Write(AsmFile,'                  lea  DI,',MemLex,#13#10);
          Write(AsmFile,'LiteralToPer',LiteralToPer,':'#13#10,
          '                  mov  AL,[SI]'#13#10,
          '                  mov  [DI],AL'#13#10,
          '                  inc  DI'#13#10,
          '                  inc  SI'#13#10,
          '                  mov  AL,[SI]'#13#10,
          '                  cmp  AL,24h'#13#10,
          '                  jne  LiteralToPer',LiteralToPer,#13#10,
          '                  mov  [DI],AL'#13#10);
          NewLex(Lex,LexId);
        end
      end;

    End;
Begin
  MemLex:=PoiskInTabSymb(LexId,1,1);
  OpaInteger:=False;
  OpaByte:=False;
  OpaChar:=False;
  DoProv:=True;
  PerStrMasStr:=False;
  ProcType:=(PoiskInTabSymb(LexId,1,2));
  MasTypeInPrisv:=Copy(ProcType,Pos(']',ProcType)+1,Length(ProcType));
  If not(Copy(PoiskInTabSymb(LexId,1,2),1,5)='ARRAY') Then
  begin
    ReadLex:=True;
    NewLex(Lex,LexId);
    If (Lex='R') and (LexId='19') Then
    begin
      NewLex(Lex,LexId);
      If not(ProcType='STRING')
      Then
      begin
        ProcZ;
        Zapis(False,ProcType);
      end
      Else
      If (Copy(PoiskInTabSymb(LexId,1,2),1,5)='ARRAY')
      Then
      begin
        MemMasStr:=(PoiskInTabSymb(LexId,1,1));
        ProcType:=(PoiskInTabSymb(LexId,1,2));
        MasTypeInPrisv:=Copy(ProcType,Pos(']',ProcType)+1,Length(ProcType));
        ReadLex:=True;
        NewLex(Lex,LexId);
        If (Lex='R') and (LexId='12') Then
        begin
          NewLex(Lex,LexId);
          DoProv:=False;
          NumRecurs:=0;
          ProcE;
          PredelMas:=Copy(ProcType,7,Length(ProcType));
          LRStr:='';
          i:=1;
          While PredelMas[i]<>'.' do
          begin
            LRStr:=LRStr+PredelMas[i];
            inc(i);
          end;
          Write(AsmFile,'                  sub  AX,',LRStr,#13#10,
          '                  inc  AX'#13#10);
          If MasTypeInPrisv='STRING' Then
          Write(AsmFile,'                  mov  BX,257'#13#10,
          '                  mul  BX'#13#10,
          '                  sub  AX,257'#13#10)
          Else begin GError:=True;ProcError(25); end;
          Write(AsmFile,'                 push  AX'#13#10);
          If (Lex='R') and (LexId='13') Then
          begin
{            NewLex(Lex,LexId);}
            PerStrMasStr:=True;
            Zapis(False,MasTypeInPrisv);
          end
          else begin GError:=True;ProcError(28); end;
        end
        else begin GError:=True;ProcError(29); end;
      end
      Else Zapis(False,ProcType);
    end
    else begin GError:=True;ProcError(28); end;
  end
  else
  begin
    ReadLex:=True;
    NewLex(Lex,LexId);
    If (Lex='R') and (LexId='12') Then
    begin
      NewLex(Lex,LexId);
      DoProv:=False;
      NumRecurs:=0;
      ProcE;
      PredelMas:=Copy(ProcType,7,Length(ProcType));
      LRStr:='';
      i:=1;
      While PredelMas[i]<>'.' do
      begin
        LRStr:=LRStr+PredelMas[i];
        inc(i);
      end;
      Write(AsmFile,'                  sub  AX,',LRStr,#13#10,
      '                  inc  AX'#13#10);
      If MasTypeInPrisv='STRING' Then
      Write(AsmFile,'                  mov  BX,257'#13#10,
      '                  mul  BX'#13#10,
      '                  sub  AX,257'#13#10)
      Else
      If MasTypeInPrisv='INTEGER' Then
      Write(AsmFile,'                  mov  BX,2'#13#10,
      '                  mul  BX'#13#10,
      '                  sub  AX,2'#13#10)
      Else
      Write(AsmFile,'                  dec  AX'#13#10);
      Write(AsmFile,'                 push  AX'#13#10);
      If (Lex='R') and (LexId='13') Then
      begin
        NewLex(Lex,LexId);
        If (Lex='R') and (LexId='19') Then
        begin
          NewLex(Lex,LexId);
          If (MasTypeInPrisv='BYTE')or(MasTypeInPrisv='INTEGER') Then
          begin
            DoProv:=True;
            OpaInteger:=False;
            OpaByte:=False;
            OpaChar:=False;
            NumRecurs:=0;
            ProcE;
          end
        end
        else begin GError:=True;ProcError(20); end;
      end
      else If not(GError) Then begin GError:=True;ProcError(28); end;
      Zapis(True,MasTypeInPrisv);
    end
    else begin GError:=True;ProcError(29); end;
  end
End;
{процедура условия IF THEN ELSE}
Procedure IfThenElse;
Var NumIf:integer;
Begin
  inc(NumIfGlobal);
  NumIf:=NumIfGlobal;
  ReadLex:=True;
  NewLex(Lex,LexId);
  OpaInteger:=False;
  OpaByte:=False;
  OpaChar:=False;
  DoProv:=True;
  NumRecurs:=0;
  ProcE;
  Write(AsmFile,'                 push  AX'#13#10);
  If (Lex='R') and ((LexId='5')or(LexId='14')or(LexId='15')or
                   (LexId='16')or(LexId='17')or(LexId='18')) Then
  Val(LexId,ZnacInIf,ErrorPer)
  Else begin GError:=True;ProcError(11); end;
  NewLex(Lex,LexId);
  NumRecurs:=0;
  ProcE;
  Write(AsmFile,'                  pop  BX'#13#10);
  If not(OpaByte) Then
  Write(AsmFile,'                  cmp  BX,AX'#13#10)
  Else
  Write(AsmFile,'                  cmp  BL,AL'#13#10);
  inc(CoolJmpGlobal);
  {действуем от обратного}
  Case ZnacInIf of
  5{'='}:begin Write(AsmFile,'                   je  Then',NumIf,#13#10);end;
 14{'>'}:begin Write(AsmFile,'                   jg  Then',NumIf,#13#10);end;
 15{'<'}:begin Write(AsmFile,'                   jl  Then',NumIf,#13#10);end;
 16{'>='}:begin Write(AsmFile,'                 jge  Then',NumIf,#13#10);end;
 17{'<='}:begin Write(AsmFile,'                 jle  Then',NumIf,#13#10);end;
 18{'<>'}:begin Write(AsmFile,'                 jne  Then',NumIf,#13#10);end;
  end;
  Write(AsmFile,'                  jmp  AfterTHEN',NumIf,#13#10);
  Write(AsmFile,'Then',NumIf,':'#13#10);
  If (Lex='S') and (LexId='4') Then
  Begin
    NewLex(Lex,LexId);
    If (Lex='R') and (LexId='20') Then
    begin
      inc(NumberBegin);
      Repeat
        CodeSegment;
        If ReadLex Then NewLex(Lex,LexId);
        ReadLex:=False;
      Until ((Lex='R') and (LexId='21')) or ((Lex='S') and (LexId='2')) or GError;
      If (Lex='R') and (LexId='21') Then dec(NumberBegin);
      If not((Lex='S') and (LexId='2')) Then ReadLex:=True;
    end
    Else begin GError:=True;ProcError(13);end;
    If not(GError) Then
    begin
      Write(AsmFile,'                  jmp  AfterELSE',NumIf,#13#10);
      Write(AsmFile,'AfterTHEN',NumIf,':'#13#10);
      If ReadLex Then NewLex(Lex,LexId);
      If (Lex='S') and (LexId='5') Then
      Begin
        NewLex(Lex,LexId);
        If (Lex='R') and (LexId='20') Then
        begin
          inc(NumberBegin);
          Repeat
            CodeSegment;
            If ReadLex Then NewLex(Lex,LexId);
            ReadLex:=False;
          Until ((Lex='R') and (LexId='21')) or ((Lex='S') and (LexId='2')) or GError;
          If (Lex='R') and (LexId='21') Then dec(NumberBegin);
          If not((Lex='S') and (LexId='2')) Then ReadLex:=True;
        end
        Else begin GError:=True;ProcError(13);end;
      End
      Else ReadLex:=False;
    end
  End
  Else begin GError:=True;ProcError(12); end;
  Write(AsmFile,'AfterELSE',NumIf,':'#13#10);
End;
{процедура цикла FOR TO DO}
Procedure ForToDo;
Var NumFor,SchBegin,SchEnd:integer;
    Sch,TypeSch:string[35];
    ToTrue:boolean;
Begin
  inc(NumForGlobal);
  NumFor:=NumForGlobal;
  ReadLex:=True;
  NewLex(Lex,LexId);
  If Lex='I' Then
  begin
    Sch:=PoiskInTabSymb(LexId,1,1);
    TypeSch:=PoiskInTabSymb(LexId,1,2);
    NewLex(Lex,LexId);
    If (Lex='R') and (LexId='19') Then
    begin
      NewLex(Lex,LexId);
      NumRecurs:=0;
      ProcE;
      {начало цикла}
      If TypeSch='INTEGER' Then
      Write(AsmFile,'                  mov  ',Sch,',AX',#13#10)
      Else Write(AsmFile,'                  mov  ',Sch,',AL',#13#10);
      Write(AsmFile,'                 push  AX'#13#10);
      ToTrue:=True;
      If (Lex='S') and ((LexId='19') or (LexId='20')) Then
      begin
        If (Lex='S') and (LexId='19') Then ToTrue:=True
        Else ToTrue:=False;
        NewLex(Lex,LexId);
        NumRecurs:=0;
        ProcE;
        {конец цикла}
        Write(AsmFile,'                  pop  BX'#13#10);
      end
      Else begin GError:=True;ProcError(19); end;
      If ToTrue Then
      Write(AsmFile,'                  sub  AX,BX'#13#10,
      '                  mov  CX,AX'#13#10)
      Else
      Write(AsmFile,'                  sub  BX,AX'#13#10,
      '                  mov  CX,BX'#13#10);
      Write(AsmFile,'                  inc  CX'#13#10,
      '                  cmp  CX,1'#13#10,
      '                  jge  For',NumFor,#13#10,
      '                  jmp  EndFor',NumFor,#13#10,
      'For',NumFor,':'#13#10,
      '                 push  CX'#13#10);
      If (Lex='S') and (LexId='21') Then
      begin
        NewLex(Lex,LexId);
        If (Lex='R') and (LexId='20') Then
        begin
          inc(NumberBegin);
          Repeat
            CodeSegment;
            If ReadLex Then NewLex(Lex,LexId);
            ReadLex:=False;
          Until ((Lex='R') and (LexId='21')) or ((Lex='S') and (LexId='2')) or GError;
          If (Lex='R') and (LexId='21') Then dec(NumberBegin);
          If not((Lex='S') and (LexId='2')) Then ReadLex:=True;
          If ToTrue Then
          Write(AsmFile,'                  inc  ',Sch,#13#10)
          Else
          Write(AsmFile,'                  dec  ',Sch,#13#10);
          inc(CoolJmpGlobal);
          Write(AsmFile,'                  pop  CX'#13#10,
          '                 loop  CoolJmp',CoolJmpGlobal,#13#10,
          '                  jmp  EndFor',NumFor,#13#10,
          'CoolJmp',CoolJmpGlobal,':'#13#10,
          '                  jmp  For',NumFor,#13#10,
          'EndFor',NumFor,':'#13#10);
        end
        Else begin GError:=True;ProcError(13);end;
      end
      Else begin GError:=True;ProcError(21);end;
    end
    Else begin GError:=True;ProcError(20); end;
  end
  Else begin GError:=True;ProcError(18); end;
End;
{процедура вывода на экран WRITE или WRITELN}
Procedure WriteWriteLn;
Var Ln,Mas,XY:boolean;
    PredelMasInWr,ProcTypeInWr,LRStrInWr,TypeElMasInWr:String[35];
    i:byte;
Begin
  If LexId='24' Then Ln:=True Else Ln:=False;
  If LexId='36' Then XY:=True Else XY:=False;
  NewLex(Lex,LexId);
  If (Lex='R') and (LexId='10') Then
  begin
  If XY Then
  begin
  i:=0;
  Repeat
    NewLex(Lex,LexId);
    ReadLex:=True;
    DoProv:=True;
    OpaInteger:=False;
    OpaByte:=False;
    OpaChar:=False;
    ProcE;
    If {not(OpaInteger) and} not(OpaChar) Then
    Write(AsmFile,'                 push  AX'#13#10);
    If not((Lex='R') and (LexId='1')) Then
    If not(GError)then begin GError:=True;ProcError(31); end;
    inc(i);
  Until (i=2) or GError;
  Write(AsmFile,'                  mov  AH,02h'#13#10,
                '                  pop  BX'#13#10,
                '                  mov  DH,BL'#13#10,
                '                  pop  BX'#13#10,
                '                  mov  DL,BL'#13#10,
                '                  mov  BH,0'#13#10,
                '                  int  10h'#13#10);
  end;
  Repeat
    NewLex(Lex,LexId);
    ReadLex:=True;
    If (Lex='L') or ((Lex='I') and (PoiskInTabSymb(LexId,1,2)='STRING'))
    Then
    begin
      Write(AsmFile,#13#10'                  mov  AH,09h'#13#10);
      If (Lex='I') and (PoiskInTabSymb(LexId,1,2)='STRING') Then
      Write(AsmFile,'                  mov  DX,offset ',PoiskInTabSymb(LexId,1,1),#13#10)
      Else
      Write(AsmFile,'                  mov  DX,offset @',LexId,#13#10);
      Write(AsmFile,'                  int  21h'#13#10,
      '                  sub  AX,AX'#13#10)
    end
    Else
    begin
      If (Lex='I') and ((Copy(PoiskInTabSymb(LexId,1,2),1,5)='ARRAY')or
      (PoiskInTabSymb(LexId,1,2)='INTEGER')or(PoiskInTabSymb(LexId,1,2)='BYTE'))
      or (Lex='C')
      Then
      begin
        If not(Lex='C') Then
        begin
          ProcTypeInWr:=PoiskInTabSymb(LexId,1,2);
          TypeElMasInWr:=Copy(ProcTypeInWr,Pos(']',ProcTypeInWr)+1,
                              Length(ProcTypeInWr))
        end;
        If TypeElMasInWr='STRING' Then
        begin
          MemLex:=PoiskInTabSymb(LexId,1,1);
          ReadLex:=True;
          NewLex(Lex,LexId);
          If (Lex='R') and (LexId='12') Then
          begin
            NewLex(Lex,LexId);
            DoProv:=False;
            NumRecurs:=0;
            ProcE;
            PredelMasInWR:=Copy(ProcTypeInWr,7,Length(ProcTypeInWr));
            LRStrInWr:='';
            i:=1;
            While PredelMasInWr[i]<>'.' do
            begin
              LRStrInWr:=LRStrInWr+PredelMasInWr[i];
              inc(i);
            end;
            Write(AsmFile,'                  sub  AX,',LRStrInWr,#13#10,
            '                  inc  AX'#13#10,
            '                  mov  BX,257'#13#10,
            '                  mul  BX'#13#10,
            '                  sub  AX,257'#13#10);
            If (Lex='R') and (LexId='13') Then
            begin
              Write(AsmFile,'                  lea  SI,',MemLex,#13#10,
              '                  xor  BX,BX'#13#10,
              '                  mov  BX,SI'#13#10,
              '                  add  BX,AX'#13#10,
              '                  mov  DX,BX'#13#10,
              '                  mov  AH,09h'#13#10);
            end
            Else begin GError:=True;ProcError(28); end;
          end
          Else begin GError:=True;ProcError(29);end;
        end
        else
        begin
          {перевод HEX -> DEC}
          inc(HexToDecGlobal);
          inc(ChistkaGlobal);
          inc(NotOtr);
          ReadLex:=True;
          DoProv:=True;
          OpaInteger:=False;
          OpaByte:=False;
          OpaChar:=False;
          NumRecurs:=0;
          ProcE;
          ReadLex:=False;
          Write(AsmFile,'                 push  AX'#13#10,
          '                  lea  DI,@WriteSymb'#13#10,
          '                  mov  CX,6'#13#10,
          '                  mov  AL,'' '''#13#10,
          'Chistka',ChistkaGlobal,':'#13#10,
          '                  mov  [DI],AL'#13#10,
          '                  inc  DI'#13#10,
          '                 loop  Chistka',ChistkaGlobal,#13#10,
          '                  pop  AX'#13#10,
          '                  lea  DI,@WriteSymb+5'#13#10,
          '                  mov  BX,10'#13#10);
          If OpaInteger Then
          Write(AsmFile,'                  cmp  AX,0'#13#10)
          Else Write(AsmFile,'                  cmp  AL,0'#13#10);
          Write(AsmFile,'                  jns  Pologit',HexToDecGlobal,#13#10,
          '                  mov  @WriteSymb,''-'''#13#10);
          If OpaInteger Then
          Write(AsmFile,'                  neg  AX'#13#10)
          Else Write(AsmFile,'                  neg  AL'#13#10);
          Write(AsmFile,'Pologit',HexToDecGlobal,':'#13#10,
          '                  mov  DX,0'#13#10,
          '                  div  BX'#13#10,
          '                   or  DL,30h'#13#10,
          '                  mov  [DI],DL'#13#10,
          '                  dec  DI'#13#10,
          '                  cmp  AL,0'#13#10,
          '                  jne  Pologit',HexToDecGlobal,#13#10,
    #13#10'                  mov  AH,09h'#13#10,
          '                  inc  DI'#13#10,
          '                  mov  DX,DI'#13#10,
          '                  cmp  @WriteSymb,''-'''#13#10,
          '                  jne  NotOtr',NotOtr,#13#10,
          '                  mov  BH,''-'''#13#10,
          '                  mov  [DI-1],BH'#13#10,
          '                  dec  DX'#13#10,
          'NotOtr',NotOtr,':'#13#10);
        end;
        Write(AsmFile,'                  int  21h'#13#10,
        '                  sub  AX,AX'#13#10);
      end
      Else
        {вывод chara}
        Write(AsmFile,#13#10,'                  lea  DI,@WriteSymb'#13#10,
        '                  mov  AL,',PoiskInTabSymb(LexId,1,1),#13#10,
        '                  add  DI,5'#13#10,
        '                  mov  [DI],AL',#13#10,
        '                  mov  AH,09h'#13#10,
        '                  mov  DX,DI'#13#10,
        '                  int  21h'#13#10,
        '                  sub  AX,AX'#13#10);
    end;
    If not((Lex='R') and (LexId='11')) and (ReadLex) Then NewLex(Lex,LexId);
    If (Lex='R') and not((LexId='1')or(LexId='11')) Then
    begin GError:=True;ProcError(23);end;
  Until ((Lex='R') and (LexId='11')) or ((Lex='S') and (LexId='2')) or GError;
  If (Ln) and not(GError) and ((Lex='R') and (LexId='11')) Then
  Write(AsmFile,'                  mov  AH,09h'#13#10,
  '                  mov  DX,offset @probel'#13#10,
  '                  int  21h'#13#10,
  '                  sub  AX,AX'#13#10);
  end
  Else begin GError:=True;ProcError(22);end;
  NewLex(Lex,LexId);
  ReadLex:=True;
End;
{очистка экрана и помещение курсора в его верхний левый угол СLRSCR}
Procedure ProcClrScr;
Begin
  Write(AsmFile,'                  mov  AX,0600h'#13#10,
  '                  mov  BH,07'#13#10,
  '                  mov  CX,0000'#13#10,
  '                  mov  DX,184Fh'#13#10,
  '                  int  10h'#13#10,
  '                  mov  AH,02'#13#10,
  '                  mov  BH,00'#13#10,
  '                  mov  DX,0000'#13#10,
  '                  int  10h'#13#10#13#10);
  NewLex(Lex,LexId);
  ReadLex:=True;
End;
{процедура ввода символов READ или READLN}
Procedure ReadReadLn;
Var Ln,Mas:boolean;
    ObrezMas,ProcTypeInR,TypeElMasInR,LGrInR:string[35];
    i:byte;
Begin
  If LexId='26' Then Ln:=True Else Ln:=False;
  NewLex(Lex,LexId);
  If (Lex='R') and (LexId='10') Then
  begin
    NewLex(Lex,LexId);
    MemLex:=PoiskInTabSymb(LexId,1,1);
    ProcTypeInR:=(PoiskInTabSymb(LexId,1,2));
    TypeElMasInR:=Copy(ProcTypeInR,Pos(']',ProcTypeInR)+1,Length(ProcTypeInR));
    Mas:=False;
    If Copy(PoiskInTabSymb(LexId,1,2),1,5)='ARRAY' Then
    begin
      Mas:=True;
      ReadLex:=True;
      NewLex(Lex,LexId);
      If (Lex='R') and (LexId='12') Then
      begin
        NewLex(Lex,LexId);
        NumRecurs:=0;
        ProcE;
        ObrezMas:=Copy(ProcTypeInR,7,Length(ProcTypeInR));;
        LGrInR:='';
        i:=1;
        While ObrezMas[i]<>'.' do
        begin
          LGrInR:=LGrInR+ObrezMas[i];
          inc(i);
        end;
        Write(AsmFile,'                  sub  AX,',LGrInR,#13#10,
        '                  inc  AX'#13#10);
        If TypeElMasInR='STRING' Then
        Write(AsmFile,'                  mov  BX,257'#13#10,
        '                  mul  BX'#13#10,
        '                  sub  AX,257'#13#10)
        Else
        If TypeElMasInR='INTEGER' Then
        Write(AsmFile,'                  mov  BX,2'#13#10,
        '                  mul  BX'#13#10,
        '                  sub  AX,2'#13#10)
        Else
        Write(AsmFile,'                  dec  AX'#13#10);
        Write(AsmFile,'                  mov  @Smesh,AX'#13#10);
        If not((Lex='R') and (LexId='13')) Then
        begin GError:=True;ProcError(28);end;
      end
      Else begin GError:=True;ProcError(29);end;
    end;
    inc(MetkaRead);
    inc(EndRead);
    inc(NegRead);
    inc(EndInput);
    inc(InputSymbol);
    If not(Mas) and (ProcTypeInR='STRING') Then
    Write(AsmFile,'                  lea  DI,',MemLex,#13#10)
    Else
    If (Mas) and (TypeElMasInR='STRING') Then
    Write(AsmFile,'                  lea  DI,',MemLex,#13#10,
    '                  xor  BX,BX'#13#10,
    '                  mov  BX,DI'#13#10,
    '                  add  BX,AX'#13#10,
    '                  mov  DI,BX'#13#10)
    Else
    Write(AsmFile,'                  lea  DI,@ASCIIToHex'#13#10);
    Write(AsmFile,'                  mov  AH,0ch'#13#10,
    '                  xor  BX,BX'#13#10,
    'InputSymbol',InputSymbol,':'#13#10,
    '                  mov  AL,01h'#13#10,
    '                  int  21h'#13#10,
    '                  cmp  AL,13'#13#10);
    If (not(Mas) and (ProcTypeInR='STRING')) or
       ((Mas) and (TypeElMasInR='STRING')) Then
    Write(AsmFile,'                   je  EndRead',EndRead,#13#10)
    Else
    Write(AsmFile,'                   je  EndInput',EndInput,#13#10);
    Write(AsmFile,'                  mov  [DI],AL'#13#10,
    '                  inc  DI'#13#10,
    '                  inc  BX'#13#10,
    '                  jmp  InputSymbol',InputSymbol,#13#10);
    If (not(Mas) and (ProcTypeInR<>'STRING')) or
       ((Mas) and (TypeElMasInR<>'STRING')) Then
    begin
      Write(AsmFile,'EndInput',EndInput,':'#13#10,
      '                  mov  CX,10'#13#10,
      '                  lea  SI,@ASCIIToHex-1'#13#10,
      'MetkaRead',MetkaRead,':'#13#10,
      '                  mov  AL,[SI+BX]'#13#10,
      '                  cmp  AL,''-'''#13#10,
      '                   je  NegRead',NegRead,#13#10,
      '                  and  AX,000Fh'#13#10,
      '                  mul  @Factor10'#13#10);
      If Mas Then
      begin
        Write(AsmFile,'                  mov  DX,BX'#13#10,
        '                  mov  BX,@Smesh'#13#10);
        If TypeElMasInR='INTEGER' Then
        Write(AsmFile,'                  add  ',MemLex,'+BX,AX'#13#10)
        Else Write(AsmFile,'                  add  ',MemLex,'+BX,AL'#13#10);
        Write(AsmFile,'                  mov  BX,DX'#13#10)
      end
      Else
      If ProcTypeInR='INTEGER' Then
      Write(AsmFile,'                  add  ',MemLex,',AX'#13#10)
      Else Write(AsmFile,'                  add  ',MemLex,',AL'#13#10);
      Write(AsmFile,'                  mov  AX,@Factor10'#13#10,
      '                  mul  CX'#13#10,
      '                  mov  @Factor10,AX'#13#10,
      '                  dec  BX'#13#10,
      '                  jnz  MetkaRead',MetkaRead,#13#10,
      'NegRead',NegRead,':'#13#10,
      '                  cmp  @ASCIIToHex,''-'''#13#10,
      '                  jne  EndRead',EndRead,#13#10);
      If Mas Then
      begin
        Write(AsmFile,'                  mov  BX,@Smesh'#13#10,
        '                  neg  ',MemLex,'+BX'#13#10)
      end
      Else
      Write(AsmFile,'                  neg  ',MemLex,#13#10);
    end;
    Write(AsmFile,'EndRead',EndRead,':'#13#10,
    '                  mov  @Factor10,1'#13#10);
    If (not(Mas) and (ProcTypeInR='STRING')) or
       ((Mas) and (TypeElMasInR='STRING'))
    Then
    Write(AsmFile,'                  mov  AL,''$'''#13#10,
    '                  mov  [DI],AL'#13#10);
    If Ln Then
      Write(AsmFile,'                  mov  AH,09h'#13#10,
      '                  mov  DX,offset @probel'#13#10,
      '                  int  21h'#13#10);
    NewLex(Lex,LexId);
    If (Lex='R') and not(LexId='11') and not(GError) Then begin GError:=True;ProcError(24);end
    Else
    begin
      NewLex(Lex,LexId);
      ReadLex:=True;
    end
  end
  Else begin GError:=True;ProcError(22);end;
End;
{процедура иннициализации графики GRAPHINIT}
Procedure GraphInit;
Begin
  Write(AsmFile,'                  mov  AH,0Fh'#13#10,
  '                  int  10h'#13#10,
  '                  mov  @VR,AL'#13#10,
  '                  mov  AH,0'#13#10,
  '                  mov  AL,13h'#13#10,
  '                  int  10h'#13#10#13#10);
  NewLex(Lex,LexId);
  ReadLex:=True;
End;
{процедура отключения графики CLOSEGRAPH}
Procedure ProcCloseGraph;
Begin
  Write(AsmFile,#13#10'                  mov  AH,0'#13#10,
  '                  mov  AL,@VR'#13#10,
  '                  int  10h'#13#10#13#10);
  NewLex(Lex,LexId);
  ReadLex:=True;
End;
{процедура рисования пиксела PUTPIX}
Procedure PutPix(PutPixTrue:boolean);
Var i:byte;
Begin
  NewLex(Lex,LexId);
  If (Lex='R') and (LexId='10') Then
  begin
    i:=0;
    Repeat
      NewLex(Lex,LexId);
      ReadLex:=True;
      DoProv:=True;
      OpaInteger:=False;
      OpaByte:=False;
      OpaChar:=False;
      ProcE;
      If {not(OpaByte) and} not(OpaChar) Then
      Write(AsmFile,'                 push  AX'#13#10);
      If not((Lex='R') and (LexId='1')) Then
      If not(GError)then begin GError:=True;ProcError(31); end;
      inc(i);
    Until (i=2) or GError;
    NewLex(Lex,LexId);
    ReadLex:=True;
    DoProv:=True;
    OpaInteger:=False;
    OpaByte:=False;
    OpaChar:=False;
    ProcE;
    If (Lex='R') and (LexId='11') Then
    begin
      If not(OpaInteger) and not(OpaChar) Then
      begin
        Write(AsmFile,'                  pop  DX'#13#10,
        '                  pop  CX'#13#10);
        If PutPixTrue Then
        Write(AsmFile,'                 call  WritePixel'#13#10)
        Else
        Write(AsmFile,'                 call  Flood'#13#10);
        NewLex(Lex,LexId);
      end
      Else If not(GError)then begin GError:=True;ProcError(25); end
    end
    Else If not(GError)then begin GError:=True;ProcError(24); end
  end
  Else If not(GError)then begin GError:=True;ProcError(22); end
End;
{процедура получения цвета пиксела по координатам GETPIX}
Procedure GetPix;
Begin
  NewLex(Lex,LexId);
  If (Lex='R') and (LexId='10') Then
  begin
    NewLex(Lex,LexId);
    ReadLex:=True;
    DoProv:=True;
    OpaInteger:=False;
    OpaByte:=False;
    OpaChar:=False;
    ProcE;
    If not(OpaByte) and not(OpaChar) Then
    begin
      Write(AsmFile,'                 push  AX'#13#10);
      If (Lex='R') and (LexId='1') Then
      begin
        NewLex(Lex,LexId);
        ReadLex:=True;
        DoProv:=True;
        OpaInteger:=False;
        OpaByte:=False;
        OpaChar:=False;
        ProcE;
        If {not(OpaByte) and} not(OpaChar) Then
        begin
          Write(AsmFile,'                  mov  DX,AX'#13#10,
          '                  pop  CX'#13#10,
          '                  mov  AH,0Dh'#13#10,
          '                  mov  BH,0'#13#10,
          '                  int  10h'#13#10);
          NewLex(Lex,LexId);
          DoProv:=False;
          OpaInteger:=False;
          OpaByte:=False;
          OpaChar:=False;
        end
        Else If not(GError)then begin GError:=True;ProcError(25); end
      end
      Else If not(GError)then begin GError:=True;ProcError(31); end
    end
    Else If not(GError)then begin GError:=True;ProcError(25); end
  end
  Else If not(GError)then begin GError:=True;ProcError(22); end
End;
{процедура рисования окружности CIRCLE}
Procedure ProcCircle;
Var Xi,Yi,di,Pr,delta:integer;
    i:byte;
Begin
  NewLex(Lex,LexId);
  If (Lex='R') and (LexId='10') Then
  begin
    i:=0;
    Repeat
      NewLex(Lex,LexId);
      ReadLex:=True;
      DoProv:=True;
      OpaInteger:=False;
      OpaByte:=False;
      OpaChar:=False;
      ProcE;
      If {not(OpaByte) and} not(OpaChar) Then
      Write(AsmFile,'                 push  AX'#13#10);
      If not((Lex='R') and (LexId='1')) Then
      If not(GError)then begin GError:=True;ProcError(31); end;
      inc(i);
    Until (i=3) or GError;
    NewLex(Lex,LexId);
    ReadLex:=True;
    DoProv:=True;
    OpaInteger:=False;
    OpaByte:=False;
    OpaChar:=False;
    ProcE;
    If (Lex='R') and (LexId='11') Then
    begin
      If not(OpaInteger) and not(OpaChar) Then
      begin
        Write(AsmFile,{R}'                  pop  BX'#13#10,
     {Y}'                  pop  CX'#13#10,
     {X}'                  pop  DX'#13#10,
        '                 call  WriteCircle'#13#10);
        NewLex(Lex,LexId);
      end
      Else If not(GError)then begin GError:=True;ProcError(25); end
    end
    Else If not(GError)then begin GError:=True;ProcError(24); end
  end
  Else If not(GError)then begin GError:=True;ProcError(22); end
End;
{процедура рисования линии и прямоугольника LINE & RECTANGLE}
Procedure ProcLineRectangle(LineTrue:boolean);
Var dy,dx,i,Y,X,S1,S2,per:integer;
    e:real;
    obmen:boolean;
Begin
  NewLex(Lex,LexId);
  If (Lex='R') and (LexId='10') Then
  begin
    i:=0;
    Repeat
      NewLex(Lex,LexId);
      ReadLex:=True;
      DoProv:=True;
      OpaInteger:=False;
      OpaByte:=False;
      OpaChar:=False;
      ProcE;
      If {not(OpaByte) and} not(OpaChar) Then
      Write(AsmFile,'                 push  AX'#13#10);
      If not((Lex='R') and (LexId='1')) Then
      If not(GError)then begin GError:=True;ProcError(31); end;
      inc(i);
    Until (i=4) or GError;
    NewLex(Lex,LexId);
    ReadLex:=True;
    DoProv:=True;
    OpaInteger:=False;
    OpaByte:=False;
    OpaChar:=False;
    ProcE;
    If (Lex='R') and (LexId='11') Then
    begin
      If not(OpaInteger) and not(OpaChar) Then
      begin
        inc(ForLine);
        Write(AsmFile,'                  mov  @cv,AL'#13#10,
        '                  pop  AX'#13#10,{Y2}
        '                  pop  BX'#13#10,{X2}
        '                  pop  CX'#13#10,{Y1}
        '                  pop  DX'#13#10);{X1}
        If LineTrue Then
        Write(AsmFile,'                  cmp  DX,BX'#13#10,
        '                  jne  NeRavnoX1X2Global',ForLine,#13#10,
        '                 call  WritePrjamajaLine'#13#10,
        '                  jmp  EndAllLine',ForLine,#13#10,
        'NeRavnoX1X2Global',ForLine,':'#13#10,
        '                  cmp  CX,AX'#13#10,
        '                  jne  NeRavnoY1Y2Global',ForLine,#13#10,
        '                 call  WritePrjamajaLine'#13#10,
        '                  jmp  EndAllLine',ForLine,#13#10,
        'NeRavnoY1Y2Global',ForLine,':'#13#10,
        '                 call  WriteLine'#13#10,
        'EndAllLine',ForLine,':'#13#10)
        Else
        Write(AsmFile,'                 call  WriteRectangle'#13#10);
        NewLex(Lex,LexId);
      end
      Else If not(GError)then begin GError:=True;ProcError(25); end
    end
    Else If not(GError)then begin GError:=True;ProcError(24); end
  end
  Else If not(GError)then begin GError:=True;ProcError(22); end
End;
{press any key}
Procedure AnyKey;
Begin
  Write(AsmFile,'                  mov     ah,0ch'#13#10,
                '                  mov     al,01h'#13#10,
                '                  int     21h'#13#10);
  NewLex(Lex,LexId);
  ReadLex:=true;
End;

Procedure CodeSegment;
Var   NumerIf:integer;
BEGIN
  If not(GError) Then
  begin
    If ReadLex Then NewLex(Lex,LexId);
    If Lex='I' Then Prisvaivanie
    Else
    If (Lex='S') and (LexId='3') Then IFThenElse
    Else
    If (Lex='S') and (LexId='18') Then ForToDo
    Else
    If (Lex='S') and ((LexId='23')or(LexId='24')or(LexId='36')) Then WriteWriteLn
    Else
    If (Lex='S') and {((LexId='25')or}(LexId='26'){)} Then ReadReadLn
    Else
    If (Lex='S') and (LexId='27') Then ProcClrScr
    Else
    If (Lex='S') and (LexId='28') Then GraphInit
    Else
    If (Lex='S') and (LexId='29') Then
       begin
         If GraphOk Then ProcCloseGraph
         Else begin GError:=True;ProcError(33); end
       end
    Else
    If (Lex='S') and (LexId='30') Then
       begin
         If GraphOk Then PutPix(True)
         Else begin GError:=True;ProcError(33); end
       end
    Else
    If (Lex='S') and (LexId='32') Then
       begin
         If GraphOk Then ProcCircle
         Else begin GError:=True;ProcError(33); end
       end
    Else
    If (Lex='S') and (LexId='33') Then
       begin
         If GraphOk Then ProcLineRectangle(True)
         Else begin GError:=True;ProcError(33); end
       end
    Else
    If (Lex='S') and (LexId='34') Then
       begin
         If GraphOk Then ProcLineRectangle(False)
         Else begin GError:=True;ProcError(33); end
       end
    Else
    If (Lex='S') and (LexId='35') Then
       begin
         If GraphOk Then PutPix(False)
         Else begin GError:=True;ProcError(33); end
       end
    Else
    If (Lex='S') and (LexId='37') Then AnyKey
    Else
    begin GError:=True;ProcError(15); end
  End;
END;

Begin
  ClrScr;
  Rewrite(AsmFile);
  ProcUk:=TablSymb;
  Write(AsmFile,';╔══════════════════════════════════════════════════╗'#13#10,
  ';║          Coded by Gray aka Sergey Rackhno        ║'#13#10,
  ';║              Rostov State University             ║'#13#10,
  ';║           of Transport and Communication         ║'#13#10,
  ';║                 gr. EC - IV - {8-))))            ║'#13#10,
  ';╚══════════════════════════════════════════════════╝'#13#10);
  {директивы}
{  Write(AsmFile,'.286'#13#10);}
  Write(AsmFile,'Title         Kompiler'#13#10,
                ';-------------------------------------------'#13#10);
  Write(AsmFile,'StackSg       segment  para stack ''Stack'''#13#10,
  '                   dw  32767 dup(?)'#13#10,
  'StackSg       ends'#13#10,
  ';-------------------------------------------'#13#10);
  Write(AsmFile,'DataSg        segment  para ''Data'''#13#10);
  While ProcUk<>nil do
  begin
    If ProcUk^.Name[1]<>'@' Then
    begin
      Write(AsmFile,Probel(ProcUk^.Name),ProcUk^.Name,'  ');
      If Copy(ProcUk^.TypePer,1,5)='ARRAY' Then
      Begin
        TypeMas:=Copy(ProcUk^.TypePer,Pos(']',ProcUk^.TypePer)+1,Length(ProcUk^.TypePer));
        If (TypeMas='BYTE') or (TypeMas='CHAR') or (TypeMas='BOOLEAN') Then
        Write(AsmFile,'db  ',ProcUk^.Razmer,' dup(0)'#13#10);
        If (TypeMas='WORD') or (TypeMas='INTEGER') Then
        Write(AsmFile,'dw  ',Trunc(ProcUk^.Razmer/2),' dup(0)'#13#10);
        If (TypeMas='STRING') Then
        Write(AsmFile,'db  ',Trunc(ProcUk^.Razmer/256),' dup(256 dup('' ''),''$'')'#13#10);
      End
      Else
      Case ProcUk^.Razmer of
      2{целое,слово}:Write(AsmFile,'dw  00'#13#10);
      1{байт,символ,булеан}:Write(AsmFile,'db  0'#13#10);
      256{строка}:Write(AsmFile,'db  256 dup('' ''),''$'''#13#10)
      end;
    end
    else Write(AsmFile,Probel(ProcUk^.Name),ProcUk^.Name,'  ',
                       'db  ''',ProcUk^.Zn,''',''$'''#13#10);
  ProcUk:=ProcUk^.Next;
  end;
  {литералы}
  UkTabLit:=TabLiter;
  NumLit:=1;
  While UkTabLit<>nil do
  begin
    Str(NumLit,ForProbel);
    ForProbel:='@'+ForProbel;
    Write(AsmFile,Probel(ForProbel),'@',NumLit,'  db  ''',UkTabLit^.El,''',''$'''#13#10);
    inc(NumLit);
    UkTabLit:=UkTabLit^.Next;
  end;
  {заполнение таблицы служебными переменными}
  Write(AsmFile,'              @probel  db  13,10,''$'''#13#10,
  '           @WriteSymb  db  6 dup('' ''),''$'''#13#10,
  '          @ASCIIToHex  db  6 dup('' '')'#13#10,
  '            @Factor10  dw  1'#13#10,
  '               @Smesh  dw  00'#13#10);
  If GraphOk Then
  Write(AsmFile,'                  @VR  db  0'#13#10,
  '                  @Xi  dw  0'#13#10,
  '                  @Yi  dw  0'#13#10,
  '                  @di  dw  0'#13#10,
  '                  @cv  db  0'#13#10,
  '               @cvzal  db  0'#13#10,
  '                @cvvn  db  0'#13#10,
  '                  @Pr  dw  0'#13#10,
  '              @SmeshX  dw  0'#13#10,
  '              @SmeshY  dw  0'#13#10,
  '                @decY  dw  0'#13#10,
  '                 @Xi2  dw  0'#13#10,
  '                 @Yi2  dw  0'#13#10,
  '                  @dX  dw  0'#13#10,
  '                  @dY  dw  0'#13#10,
  '                  @S1  dw  0'#13#10,
  '                  @S2  dw  0'#13#10,
  '                   @e  dw  0'#13#10,
  '                @ince  dw  0'#13#10,
  '               @obmen  db  0'#13#10,
  '            @SchSteck  dw  0'#13#10);
  Write(AsmFile,'DataSg        ends'#13#10,
                ';------------------------------------------'#13#10);
  Write(AsmFile,'CodeSg        segment  para ''Code'''#13#10,
                '               assume  CS:CodeSg,DS:DataSg,SS:StackSg'#13#10#13#10);
  If CircleOk Then
  Write(AsmFile,'DeltaForCircle   proc  far'#13#10,
  '                  mov  BX,2'#13#10,
  '                  inc  @Xi'#13#10,
  '                  dec  @Yi'#13#10,
  '                  mov  AX,@Yi'#13#10,
  '                  mul  BX'#13#10,
  '                  mov  CX,AX'#13#10,
  '                  mov  AX,@Xi'#13#10,
  '                  mul  BX'#13#10,
  '                  sub  AX,CX'#13#10,
  '                  add  AX,@di'#13#10,
  '                  add  AX,2'#13#10,
  '                  mov  @di,AX'#13#10,
  '                  ret'#13#10,
  'DeltaForCircle   endp'#13#10#13#10);
  {пиксел}
  If GraphOk Then
  Write(AsmFile,'WritePixel       proc  far'#13#10,
  '                  mov  AH,0Ch'#13#10,
  '                  mov  BH,0'#13#10,
  '                  int  10h'#13#10,
  '                  ret'#13#10,
  'WritePixel       endp'#13#10#13#10);
  {прямая линия}
  If (LineOk) or (RectangleOk) Then
  Write(AsmFile,'WritePrjamajaLine proc far'#13#10,
  '                   cmp  DX,BX'#13#10,
  '                   jne  NeRavnoX1X2'#13#10,
  '                   mov  @Xi,DX'#13#10,{X}
  '                   mov  @Yi,AX'#13#10,{Y2}
  '                   sub  AX,CX'#13#10,
  '                   cmp  AX,0'#13#10,
  '                   jge  Y2BolsheY1'#13#10,
  '                   neg  AX'#13#10,
  '                   jmp  ShetchukVertikal'#13#10,
  'Y2BolsheY1:'#13#10,
  '                   mov  @Yi,CX'#13#10,
  'ShetchukVertikal:'#13#10,
  '                   mov  CX,AX'#13#10,
  '                   inc  CX'#13#10,
  'VertikalLine:'#13#10,
  '                  push  CX'#13#10,
  '                   mov  AL,@cv'#13#10,
  '                   mov  CX,@Xi'#13#10,
  '                   mov  DX,@Yi'#13#10,
  '                  call  WritePixel'#13#10,
  '                   inc  @Yi'#13#10,
  '                   pop  CX'#13#10,
  '                  loop  VertikalLine'#13#10,
  '                   jmp  EndPrjamLine'#13#10,

  'NeRavnoX1X2:'#13#10,
  '                   cmp  CX,AX'#13#10,
  '                   jne  EndPrjamLine'#13#10,
  '                   mov  @Yi,AX'#13#10,{Y}
  '                   mov  @Xi,BX'#13#10,{X2}
  '                   sub  BX,DX'#13#10,
  '                   cmp  BX,0'#13#10,
  '                   jge  X2BolsheX1'#13#10,
  '                   neg  BX'#13#10,
  '                   jmp  ShetchukHorizont'#13#10,
  'X2BolsheX1:'#13#10,
  '                   mov  @Xi,DX'#13#10,
  'ShetchukHorizont:'#13#10,
  '                   mov  CX,BX'#13#10,
  '                   inc  CX'#13#10,
  'HorizontalLine:'#13#10,
  '                  push  CX'#13#10,
  '                   mov  AL,@cv'#13#10,
  '                   mov  CX,@Xi'#13#10,
  '                   mov  DX,@Yi'#13#10,
  '                  call  WritePixel'#13#10,
  '                   inc  @Xi'#13#10,
  '                   pop  CX'#13#10,
  '                  loop  HorizontalLine'#13#10,
  'EndPrjamLine:'#13#10,
  '                   ret'#13#10,
  'WritePrjamajaLine endp'#13#10#13#10);
  {линия}
  If LineOk Then
  Write(AsmFile,'WriteLine        proc  far'#13#10,
  '                   mov  @Xi,DX'#13#10,
  '                   mov  @Yi,CX'#13#10,
  '                   mov  @Xi2,BX'#13#10,
  '                   mov  @Yi2,AX'#13#10,
  '                   sub  BX,DX'#13#10,
  '                   cmp  BX,0'#13#10,
  '                   jge  G1Line'#13#10,
  '                   neg  BX'#13#10,
  'G1Line:'#13#10,
  '                   mov  @dX,BX'#13#10,
  '                   sub  AX,CX'#13#10,
  '                   cmp  AX,0'#13#10,
  '                   jge  G2Line'#13#10,
  '                   neg  AX'#13#10,
  'G2Line:'#13#10,
  '                   mov  @dY,AX'#13#10,
  '                   mov  BX,@Xi2'#13#10,
  '                   cmp  BX,DX'#13#10,
  '                    je  ESignX1X2Line'#13#10,
  '                    jg  GSignX1X2Line'#13#10,
  '                   mov  @S1,-1'#13#10,
  '                   jmp  NextSign1'#13#10,
  'GSignX1X2Line:'#13#10,
  '                   mov  @S1,1'#13#10,
  '                   jmp  NextSign1'#13#10,
  'ESignX1X2Line:',#13#10,
  '                   mov  @S1,0'#13#10,
  'NextSign1:'#13#10,
  '                   mov  AX,@Yi2'#13#10,
  '                   cmp  AX,CX'#13#10,
  '                    je  ESignY1Y2Line'#13#10,
  '                    jg  GSignY1Y2Line'#13#10,
  '                   mov  @S2,-1'#13#10,
  '                   jmp  NextSign2'#13#10,
  'GSignY1Y2Line:'#13#10,
  '                   mov  @S2,1'#13#10,
  '                   jmp  NextSign2'#13#10,
  'ESignY1Y2Line:',#13#10,
  '                   mov  @S2,0'#13#10,
  'NextSign2:'#13#10,
  '                   mov  AX,@dY'#13#10,
  '                   mov  BX,@dX'#13#10,
  '                   cmp  AX,BX'#13#10,
  '                   jle  NotSwap'#13#10,
  '                   mov  @dX,AX'#13#10,
  '                   mov  @dY,BX'#13#10,
  '                   mov  @obmen,1'#13#10,
  '                   jmp  AfterSwap'#13#10,
  'NotSwap:'#13#10,
  '                   mov  @obmen,0'#13#10,
  'AfterSwap:'#13#10,
  '                   mov  AX,@dY'#13#10,
  '                   mov  BX,2'#13#10,
  '                   mul  BX'#13#10,
  '                   mov  BX,@dX'#13#10,
  '                   sub  AX,BX'#13#10,
  '                   inc  @ince'#13#10,
  '                   mov  BX,@ince'#13#10,
  '                   cmp  BX,2'#13#10,
  '                   jne  NotDec05'#13#10,
  '                   dec  AX'#13#10,
  '                   mov  @ince,0'#13#10,
  'NotDec05:'#13#10,
  '                   mov  @e,AX'#13#10,
  '                   mov  CX,@dX'#13#10,
  'NextPixelOfLine:'#13#10,
  '                  push  CX'#13#10,
  '                   mov  CX,@Xi'#13#10,
  '                   mov  DX,@Yi'#13#10,
  '                   mov  AL,@cv'#13#10,
  '                  call  WritePixel'#13#10,
  '                   mov  AX,@e'#13#10,
  '                   cmp  AX,0'#13#10,
  '                    jl  EndWhileInLine'#13#10,
  'WhileInLine:'#13#10,
  '                   mov  AL,@obmen'#13#10,
  '                   cmp  AL,0'#13#10,
  '                   jne  Not@obmen1InLine'#13#10,
  '                   mov  AX,@S2'#13#10,
  '                   add  @Yi,AX'#13#10,
  '                   jmp  EndIf1InLine'#13#10,
  'Not@obmen1InLine:'#13#10,
  '                   mov  AX,@S1'#13#10,
  '                   add  @Xi,AX'#13#10,
  'EndIf1InLine:'#13#10,
  '                   mov  AX,@dX'#13#10,
  '                   mov  BX,2'#13#10,
  '                   mul  BX'#13#10,
  '                   sub  @e,AX'#13#10,
  '                   mov  AX,@e'#13#10,
  '                   cmp  AX,0'#13#10,
  '                   jge  WhileInLine'#13#10,
  'EndWhileInLine:'#13#10,
  '                   mov  AL,@obmen'#13#10,
  '                   cmp  AL,0'#13#10,
  '                   jne  Not@obmen2InLine'#13#10,
  '                   mov  AX,@S1'#13#10,
  '                   add  @Xi,AX'#13#10,
  '                   jmp  EndIf2InLine'#13#10,
  'Not@obmen2InLine:'#13#10,
  '                   mov  AX,@S2'#13#10,
  '                   add  @Yi,AX'#13#10,
  'EndIf2InLine:'#13#10,
  '                   mov  AX,@dY'#13#10,
  '                   mov  BX,2'#13#10,
  '                   mul  BX'#13#10,
  '                   add  @e,AX'#13#10,
  '                   pop  CX'#13#10,
  '                  loop  CoolJmpInLine'#13#10,
  '                   jmp  EndLine'#13#10,
  'CoolJmpInLine:'#13#10,
  '                   jmp  NextPixelOfLine'#13#10,
  'EndLine:'#13#10,
  '                   ret'#13#10,
  'WriteLine         endp'#13#10#13#10);
  {окружность}
  If CircleOk Then
  Write(AsmFile,'WriteCircle      proc  far'#13#10,
  '                  mov  @cv,AL'#13#10,
  '                  mov  @Xi,0'#13#10,
  '                  mov  @Pr,0'#13#10,
  '                  mov  @Yi,BX'#13#10,
  '                  mov  @SmeshX,DX'#13#10,
  '                  mov  @SmeshY,CX'#13#10,
  '                  mov  AX,1'#13#10,
  '                  sub  AX,BX'#13#10,
  '                  mov  BX,2'#13#10,
  '                  mul  BX'#13#10,
  '                  mov  @di,AX'#13#10,
  'StartCircle:'#13#10,
  '                  mov  DX,@Yi'#13#10,
  '                  mov  CX,@Xi'#13#10,
  '                  mov  AX,@SmeshX'#13#10,
  '                  add  CX,AX'#13#10,
  '                  mov  AX,@SmeshY'#13#10,
  '                  add  DX,AX'#13#10,
  '                  mov  AL,@cv'#13#10,
  '                 call  WritePixel'#13#10,

  '                  mov  DX,@Yi'#13#10,
  '                  mov  CX,@Xi'#13#10,
  '                  neg  DX'#13#10,
  '                  mov  AX,@SmeshX'#13#10,
  '                  add  CX,AX'#13#10,
  '                  mov  AX,@SmeshY'#13#10,
  '                  add  DX,AX'#13#10,
  '                  mov  AL,@cv'#13#10,
  '                 call  WritePixel'#13#10,

  '                  mov  DX,@Yi'#13#10,
  '                  mov  CX,@Xi'#13#10,
  '                  neg  CX'#13#10,
  '                  mov  AX,@SmeshX'#13#10,
  '                  add  CX,AX'#13#10,
  '                  mov  AX,@SmeshY'#13#10,
  '                  add  DX,AX'#13#10,
  '                  mov  AL,@cv'#13#10,
  '                 call  WritePixel'#13#10,

  '                  mov  DX,@Yi'#13#10,
  '                  mov  CX,@Xi'#13#10,
  '                  neg  DX'#13#10,
  '                  neg  CX'#13#10,
  '                  mov  AX,@SmeshX'#13#10,
  '                  add  CX,AX'#13#10,
  '                  mov  AX,@SmeshY'#13#10,
  '                  add  DX,AX'#13#10,
  '                  mov  AL,@cv'#13#10,
  '                 call  WritePixel'#13#10,

  '                  cmp  @di,0'#13#10,
  '                  jge  Di1InCircle'#13#10,
  '                  mov  BX,2'#13#10,
  '                  mov  AX,@di'#13#10,
  '                  mul  BX'#13#10,
  '                  mov  CX,AX'#13#10,
  '                  mov  AX,@Yi'#13#10,
  '                  mul  BX'#13#10,
  '                  add  AX,CX'#13#10,
  '                  dec  AX'#13#10,
  '                  cmp  AX,0'#13#10,
  '                   jg  DeltaInCircle'#13#10,
  '                  inc  @Xi'#13#10,
  '                  mov  AX,@Xi'#13#10,
  '                  mov  BX,2'#13#10,
  '                  mul  BX'#13#10,
  '                  mov  BX,@di'#13#10,
  '                  add  AX,BX'#13#10,
  '                  inc  AX'#13#10,
  '                  mov  @di,AX'#13#10,
  '                  jmp  NextCircle'#13#10,
  'DeltaInCircle:'#13#10,
  '                 call  DeltaForCircle'#13#10,
  '                  jmp  NextCircle'#13#10,
  'Di1InCircle:'#13#10,
  '                  cmp  @di,0'#13#10,
  '                   je  Di2InCircle'#13#10,
  '                  mov  BX,2'#13#10,
  '                  mov  AX,@Xi'#13#10,
  '                  mul  BX'#13#10,
  '                  mov  CX,AX'#13#10,
  '                  mov  AX,@di'#13#10,
  '                  mul  BX'#13#10,
  '                  sub  AX,CX'#13#10,
  '                  dec  AX'#13#10,
  '                  cmp  AX,0'#13#10,
  '                   jg  DeltaStrihInCircle'#13#10,
  '                 call  DeltaForCircle'#13#10,
  '                  jmp  NextCircle'#13#10,
  'DeltaStrihInCircle:'#13#10,
  '                  dec  @Yi'#13#10,
  '                  mov  AX,@Yi'#13#10,
  '                  mov  BX,2'#13#10,
  '                  mul  BX'#13#10,
  '                  mov  BX,@di'#13#10,
  '                  sub  BX,AX'#13#10,
  '                  inc  BX'#13#10,
  '                  mov  @di,BX'#13#10,
  '                  jmp  NextCircle'#13#10,
  'Di2InCircle:'#13#10,
  '                 call  DeltaForCircle'#13#10,
  'NextCircle:'#13#10,
  '                  mov  AX,@Yi'#13#10,
  '                  mov  BX,@Pr'#13#10,
  '                  cmp  AX,BX'#13#10,
  '                   jl  EndCircle'#13#10,
  '                  jmp  StartCircle'#13#10,
  'EndCircle:'#13#10,
  '                  ret'#13#10,
  'WriteCircle      endp'#13#10#13#10);
  {прямоугольник}
  If RectangleOk Then
  Write(AsmFile,'WriteRectangle   proc  far'#13#10,
  '                  mov  @dX,DX'#13#10,
  '                  mov  @dy,CX'#13#10,
  '                  mov  @Xi2,BX'#13#10,
  '                  mov  @Yi2,AX'#13#10,
  '                  mov  AX,CX'#13#10,
  '                 call  WritePrjamajaLine'#13#10,
  '                  mov  DX,@dX'#13#10,
  '                  mov  CX,@dY'#13#10,
  '                  mov  BX,DX'#13#10,
  '                  mov  AX,@Yi2'#13#10,
  '                 call  WritePrjamajaLine'#13#10,
  '                  mov  DX,@dX'#13#10,
  '                  mov  CX,@Yi2'#13#10,
  '                  mov  BX,@Xi2'#13#10,
  '                  mov  AX,CX'#13#10,
  '                 call  WritePrjamajaLine'#13#10,
  '                  mov  DX,@Xi2'#13#10,
  '                  mov  CX,@dY'#13#10,
  '                  mov  BX,DX'#13#10,
  '                  mov  AX,@Yi2'#13#10,
  '                 call  WritePrjamajaLine'#13#10,
  '                  ret'#13#10,
  'WriteRectangle   endp'#13#10#13#10);
  {заливка}
  If FloodOk Then
  Write(AsmFile,'Flood            proc  far'#13#10,
  '                  mov  @cvzal,AL'#13#10,
  '                 push  CX'#13#10,
  '                 push  DX'#13#10,
  '                  inc  @SchSteck'#13#10,
  '                  xor  AX,AX'#13#10,
  '                  mov  AH,0Dh'#13#10,
  '                  mov  BH,0'#13#10,
  '                  int  10h'#13#10,
  '                  mov  @cvvn,AL'#13#10,
  'WhileInFlood:'#13#10,
  '                  mov  @obmen,1'#13#10,
  '                  pop  DX'#13#10,
  '                  pop  CX'#13#10,
  '                 push  CX'#13#10,
  '                 push  DX'#13#10,
  '                  xor  AX,AX'#13#10,
  '                  mov  AH,0Dh'#13#10,
  '                  mov  BH,0'#13#10,
  '                  int  10h'#13#10,
  '                  cmp  AL,@cvzal'#13#10,
  '                   je  CvZal'#13#10,
  '                  mov  AL,@cvzal'#13#10,
  '                 call  WritePixel'#13#10,
  '                  pop  DX'#13#10,
  '                  pop  CX'#13#10,
  '                 push  CX'#13#10,
  '                 push  DX'#13#10,
  '                  mov  @Xi,CX'#13#10,
  '                  mov  @Yi,DX'#13#10,
  '                  mov  @obmen,0'#13#10,
  'CvZal:'#13#10,
  '                  mov  AX,@SchSteck'#13#10,
  '                  cmp  AX,0'#13#10,
  '                  jne  SteckNotNil1'#13#10,
  '                  jmp  NilInSteck'#13#10,
  'SteckNotNil1:'#13#10,
  '                  pop  DX'#13#10,
  '                  pop  CX'#13#10,
  '                  dec  @SchSteck'#13#10,
  '                  mov  AX,@SchSteck'#13#10,
  '                  cmp  AX,0'#13#10,
  '                   je  SteckNil'#13#10,
  '                  mov  AL,@obmen'#13#10,
  '                  cmp  AL,0'#13#10,
  '                   je  NotFlag'#13#10,
  '                  pop  DX'#13#10,
  '                  pop  CX'#13#10,
  '                 push  CX'#13#10,
  '                 push  DX'#13#10,
  '                  mov  @Xi,CX'#13#10,
  '                  mov  @Yi,DX'#13#10,
  'SteckNil:'#13#10,
  'NotFlag:'#13#10,
  '                  mov  CX,@Xi'#13#10,
  '                  inc  CX'#13#10,
  '                  mov  DX,@Yi'#13#10,
  '                  xor  AX,AX'#13#10,
  '                  mov  AH,0Dh'#13#10,
  '                  mov  BH,0'#13#10,
  '                  int  10h'#13#10,
  '                  cmp  AL,@cvzal'#13#10,
  '                   je  NextIfInFlood1'#13#10,
  '                  cmp  AL,@cvvn'#13#10,
  '                  jne  NextIfInFlood1'#13#10,
  '                  cmp  CX,320'#13#10,
  '                   jg  NextIfInFlood1'#13#10,
  '                 push  CX'#13#10,
  '                 push  DX'#13#10,
  '                  inc  @SchSteck'#13#10,
  'NextIfInFlood1:'#13#10,
  '                  dec  CX'#13#10,
  '                  dec  DX'#13#10,
  '                  xor  AX,AX'#13#10,
  '                  mov  AH,0Dh'#13#10,
  '                  mov  BH,0'#13#10,
  '                  int  10h'#13#10,
  '                  cmp  AL,@cvzal'#13#10,
  '                   je  NextIfInFlood2'#13#10,
  '                  cmp  AL,@cvvn'#13#10,
  '                  jne  NextIfInFlood2'#13#10,
  '                  cmp  DX,0'#13#10,
  '                   jl  NextIfInFlood2'#13#10,
  '                 push  CX'#13#10,
  '                 push  DX'#13#10,
  '                  inc  @SchSteck'#13#10,
  'NextIfInFlood2:'#13#10,
  '                  dec  CX'#13#10,
  '                  inc  DX'#13#10,
  '                  xor  AX,AX'#13#10,
  '                  mov  AH,0Dh'#13#10,
  '                  mov  BH,0'#13#10,
  '                  int  10h'#13#10,
  '                  cmp  AL,@cvzal'#13#10,
  '                   je  NextIfInFlood3'#13#10,
  '                  cmp  AL,@cvvn'#13#10,
  '                  jne  NextIfInFlood3'#13#10,
  '                  cmp  CX,0'#13#10,
  '                   jl  NextIfInFlood3'#13#10,
  '                 push  CX'#13#10,
  '                 push  DX'#13#10,
  '                  inc  @SchSteck'#13#10,
  'NextIfInFlood3:'#13#10,
  '                  inc  CX'#13#10,
  '                  inc  DX'#13#10,
  '                  xor  AX,AX'#13#10,
  '                  mov  AH,0Dh'#13#10,
  '                  mov  BH,0'#13#10,
  '                  int  10h'#13#10,
  '                  cmp  AL,@cvzal'#13#10,
  '                   je  NextIfInFlood4'#13#10,
  '                  cmp  AL,@cvvn'#13#10,
  '                  jne  NextIfInFlood4'#13#10,
  '                  cmp  DX,200'#13#10,
  '                   jg  NextIfInFlood4'#13#10,
  '                 push  CX'#13#10,
  '                 push  DX'#13#10,
  '                  inc  @SchSteck'#13#10,
  'NextIfInFlood4:'#13#10,
  'NilInSteck:'#13#10,
  '                  mov  AX,@SchSteck'#13#10,
  '                  cmp  AX,0'#13#10,
  '                   je  EndFlood'#13#10,
  '                  jmp  WhileInFlood'#13#10,
  'EndFlood:'#13#10,
  '                  ret'#13#10,
  'Flood            endp'#13#10#13#10);
  Write(AsmFile,'Begin            Proc  far'#13#10,
  '                 push  DS'#13#10,
  '                  sub  AX,AX'#13#10,
  '                 push  AX'#13#10,
  '                  mov  AX,DataSg'#13#10,
  '                  mov  DS,AX'#13#10#13#10);
  {---------------------------Syntax---------------------------------------}
  Assign(ScanFile,'Exit.txt');
  Reset(ScanFile);
  StrError:=1;{номер строки с ошибкой}
  Read(ScanFile,BukFromFile);
  NewLex(Lex,LexId);
  FindBegin:=False;
  {ищем begin}
  While (not(eof(ScanFile))) and not(FindBegin) do
  begin
    If (Lex='S') and (LexId='1') Then FindBegin:=True
    Else NewLex(Lex,LexId);
  end;
  If not(FindBegin) Then begin GError:=True;ProcError(3); end
  Else
  begin
    {число If - ов}
    NumIfGlobal:=0;
    {число For - ов}
    NumForGlobal:=0;
    {число Read - ов}
    EndInput:=0;
    {число выводов числовых переменных (HEX->DEC)}
    HexToDecGlobal:=0;
    {число очисток переменных используемых для вывода ID byte or integer}
    ChistkaGlobal:=0;
    {число Far JMP-ов используемых как условные переходы}
    CoolJmpGlobal:=0;
    {метка, используемая в процедуре READ}
    MetkaRead:=0;
    EndRead:=0;
    NegRead:=0;
    InputSymbol:=0;
    {метка, используемая в процедуре WRITE}
    NotOtr:=0;
    {метка, используемая при заполнении строковой переменной}
    LiteralToPer:=0;
    {метки используемая при построении линии}
    ForLine:=0;
    ReadLex:=True;
    Konec:=False;
    NumberBegin:=0;
    Repeat
    CodeSegment;
     If ReadLex Then NewLex(Lex,LexId);
     If (NumberBegin <> 0) and not(GError) Then
     begin
       GError:=True;
       If NumberBegin>0 Then ProcError(17)
       Else ProcError(3);
     end
     Else
     begin
     If (Lex='S') and (LexId='2') Then
     begin
       NewLex(Lex,LexId);
       If (Lex='R') and (LexId='2') Then Konec:=True;
     end
     Else ReadLex:=False;
     end;
    Until Konec or GError;
  end;
  Close(ScanFile);
  {---------------------------Syntax---------------------------------------}
  Write(AsmFile,'EndPrg:           '#13#10,
  '                  mov  AX,4C00h'#13#10,
  '                  int  21h'#13#10,
  '                  ret'#13#10,
  'Begin            endp'#13#10);
  Write(AsmFile,'CodeSg           ends'#13#10,
                '                  end Begin');
  Close(AsmFile);
End;
BEGIN
  ClrScr;
  GError:=False;
  NewFiles;
  FileName;
  If not(GError) Then
  LexxAnaliz;
  If not(GError) Then
  PostrTabSymb;
{  If not(GError) Then
  WriteTablSymb;}
  If not(GError) Then
  ToAsm;
END.
